VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frmMain 
   Appearance      =   0  'Flat
   Caption         =   "ERwin Spy - ERwin API Sample"
   ClientHeight    =   4365
   ClientLeft      =   1095
   ClientTop       =   1770
   ClientWidth     =   9990
   BeginProperty Font 
      Name            =   "MS Sans Serif"
      Size            =   8.25
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   Icon            =   "ERwinSpy_Addin_Form.frx":0000
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4365
   ScaleWidth      =   9990
   ShowInTaskbar   =   0   'False
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   7320
      Top             =   120
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton btProperties 
      Caption         =   ">>"
      Height          =   1935
      Left            =   4800
      TabIndex        =   4
      ToolTipText     =   "Click to see properties"
      Top             =   1320
      Width           =   375
   End
   Begin ComctlLib.TreeView tvObjects 
      Height          =   3495
      Left            =   120
      TabIndex        =   1
      ToolTipText     =   "Double click to expand"
      Top             =   720
      Width           =   4455
      _ExtentX        =   7858
      _ExtentY        =   6165
      _Version        =   327682
      HideSelection   =   0   'False
      LabelEdit       =   1
      Style           =   7
      Appearance      =   1
   End
   Begin ComctlLib.TreeView tvProperties 
      Height          =   3495
      Left            =   5400
      TabIndex        =   2
      ToolTipText     =   "Double click to expand"
      Top             =   720
      Width           =   4455
      _ExtentX        =   7858
      _ExtentY        =   6165
      _Version        =   327682
      HideSelection   =   0   'False
      LabelEdit       =   1
      Sorted          =   -1  'True
      Style           =   7
      Appearance      =   1
   End
   Begin VB.Label ERwinSpyLabel 
      Alignment       =   2  'Center
      Caption         =   "ERwin Spy"
      BeginProperty Font 
         Name            =   "Arial Narrow"
         Size            =   20.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   495
      Left            =   3600
      TabIndex        =   5
      Top             =   0
      Width           =   2775
   End
   Begin VB.Label LabelProperties 
      Alignment       =   1  'Right Justify
      Caption         =   "Properties"
      Height          =   255
      Left            =   6600
      TabIndex        =   3
      Top             =   360
      Width           =   3255
   End
   Begin VB.Label Label 
      Caption         =   "Objects"
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   360
      Width           =   1935
   End
   Begin VB.Menu mnFile 
      Caption         =   "&File"
      Begin VB.Menu mnFileOpen 
         Caption         =   "File &Open ..."
         Shortcut        =   ^O
      End
      Begin VB.Menu mnClose 
         Caption         =   "Close Open Model"
      End
      Begin VB.Menu mnSep2 
         Caption         =   "-"
      End
      Begin VB.Menu mnOptions 
         Caption         =   "&Options"
         Begin VB.Menu mnExtraDebug 
            Caption         =   "Extra Debug Info"
         End
      End
      Begin VB.Menu mnSep1 
         Caption         =   "-"
      End
      Begin VB.Menu mnExit 
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnModels 
      Caption         =   "&Models"
      Begin VB.Menu mnModelsArray 
         Caption         =   "-"
         Index           =   0
      End
   End
   Begin VB.Menu mnHemp 
      Caption         =   "&Help"
      NegotiatePosition=   3  'Right
      Begin VB.Menu mnAbout 
         Caption         =   "&About Erwin Spy"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private btMouseLeft As Boolean              ' To keep a state of the mouse buttons
Private oApplication As SCAPI.Application   ' SCAPI Application
Private oSession As SCAPI.Session           ' Active session

' Init the form with SCAPI Application reference
Sub Init(oApp As SCAPI.Application)
    Set oApplication = oApp
End Sub

Private Sub Form_Load()
    Dim Version As String

    ' Reset UI
    ClearViews
    
    ' Disable the expand button
    btProperties.Enabled = False
    
    ' Populate Models menu
    PopulateModels
    
    
End Sub

Private Sub Form_Resize()
    ' Resize controls on the form
    
    Dim nAddWidth As Integer
    nAddWidth = IIf(Me.Width > 10110, (Me.Width - 10110) / 2, 0)
    LabelProperties.Left = IIf(Me.Width > 10110, Me.Width - 3510, 5400)
    tvProperties.Left = IIf(Me.Width > 10110, 5400 + nAddWidth, 5400)
    tvProperties.Width = IIf(Me.Width > 10110, 4455 + nAddWidth, 4455)
    tvProperties.Height = IIf(Me.Height > 5055, Me.Height - 1600, 3495)
    btProperties.Left = IIf(Me.Width > 10110, 4800 + nAddWidth, 4800)
    tvObjects.Width = IIf(Me.Width > 10110, 4455 + nAddWidth, 4455)
    tvObjects.Height = IIf(Me.Height > 5055, Me.Height - 1600, 3495)
    ERwinSpyLabel.Left = IIf(Me.Width > 10110, 3600 + nAddWidth, 3600)
End Sub

Private Sub mnAbout_Click()
    frmAbout.Init oApplication
    frmAbout.Show 1, Me
End Sub

Private Sub mnExit_Click()
    Unload Me
End Sub

Private Sub Form_Unload(Cancel As Integer)

oApplication.Sessions.Clear
Set oApplication = Nothing

End Sub

' Populate Models menu with available models
Private Sub PopulateModels()
    ' Reset the menu array
    mnModelsArray(0).Visible = True
    Do While mnModelsArray.Count > 1
        Unload mnModelsArray(mnModelsArray.Count - 1)
    Loop
    
    ' Start adding
    Dim oUnit As SCAPI.PersistenceUnit
    Dim nIdx As Long
    
    nIdx = 1
    
    ' Populate the menu with models
    For Each oUnit In oApplication.PersistenceUnits
        Load mnModelsArray(nIdx)
        mnModelsArray(nIdx).Caption = oUnit.Name
        nIdx = nIdx + 1
    Next
    
    ' Add a separator
    Load mnModelsArray(nIdx)
    mnModelsArray(nIdx).Caption = "-- Meta Data --"
    mnModelsArray(nIdx).Enabled = False
    nIdx = nIdx + 1
    
    ' Add intrinsic meta data
    Load mnModelsArray(nIdx)
    mnModelsArray(nIdx).Caption = "Intrinsic Meta"
    nIdx = nIdx + 1
    
    ' Populate the menu with model data
    For Each oUnit In oApplication.PersistenceUnits
        Load mnModelsArray(nIdx)
        mnModelsArray(nIdx).Caption = oUnit.Name
        nIdx = nIdx + 1
    Next

    mnModelsArray(0).Visible = False
    
End Sub

Private Sub mnExtraDebug_Click()
    ' Check/Uncheck
    mnExtraDebug.Checked = Not mnExtraDebug.Checked
End Sub

' Open a file
Private Sub mnFileOpen_Click()

   ' CancelError is True.
   On Error GoTo ErrHandler
   ' Set filters.
   CommonDialog1.Filter = "All Files (*.*)|*.*|ER1 Files (*.er1)|*.er1"
   ' Specify default filter.
   CommonDialog1.FilterIndex = 2
   ' Current directory
   CommonDialog1.InitDir = CurDir
   CommonDialog1.FileName = ""
   ' No read only and file must exists
   CommonDialog1.Flags = CommonDialog1.Flags Or _
                        cdlOFNHideReadOnly Or _
                        cdlOFNFileMustExist
   
   ' Display the Open dialog box.
   CommonDialog1.ShowOpen
   
   ' Load file
   On Error GoTo APIHandler
   Dim oModel As SCAPI.PersistenceUnit
   
   Me.MousePointer = vbHourglass

   Set oModel = oApplication.PersistenceUnits.Add("erwin://" + CommonDialog1.FileName, "RDO=Yes")
   
   ' Reset the model menu
   PopulateModels
   
   Me.MousePointer = vbDefault
   ' Locate the new file in the menu
    Dim nIdx As Integer
    For nIdx = 1 To mnModelsArray.Count - 1
        If mnModelsArray(nIdx).Caption = oModel.Name Then
            ' leave
            Exit For
        End If
    Next
    
    If nIdx >= mnModelsArray.Count Then
        ' Error
        MsgBox "Internal error while loading " + oModel.Name + " model"
        Set oModel = Nothing
        ClearViews
   End If
   
   ' Activate it
   mnModelsArray_Click (nIdx)
   Exit Sub

ErrHandler:
    ' User pressed Cancel button.
   Exit Sub
   
APIHandler:
   Me.MousePointer = vbDefault
   MsgBox "Failed to open a file with error msg: " + Err.Description
End Sub

' A model selected
Private Sub mnModelsArray_Click(Index As Integer)
    If (Not mnModelsArray(Index).Checked) Then
        ' Close the current window and open a session with a new one
        If Not oSession Is Nothing Then
            oSession.Close
        End If
        oApplication.Sessions.Clear
        
        ' Check if we have a window selected previously
        Dim nIdx As Integer
        For nIdx = 1 To mnModelsArray.Count - 1
            If mnModelsArray(nIdx).Checked Then
                ' Have it unchecked
                mnModelsArray(nIdx).Checked = False
            End If
        Next
        
        ' Reset UI
        ClearViews
        btProperties.Enabled = False
        
        ' Open a new session
        On Error Resume Next
        
        Set oSession = oApplication.Sessions.Add
        If oSession Is Nothing Then
            MsgBox "Failed to create a session. An error is " + Err.Description
            Exit Sub
        End If
        
        ' Attache to persistence unit. If the INdex is bigger then number of
        ' units, then we are looking for meta data
        Dim eLevel As SCAPI.SC_SessionLevel
        eLevel = SCD_SL_M0          ' Native data
        If Index <= oApplication.PersistenceUnits.Count Then
            ' This is native data level
            nIdx = Index - 1
        Else
            ' This is meta data level
            nIdx = Index - oApplication.PersistenceUnits.Count - 3
            eLevel = SCD_SL_M1
        End If
        
        Dim oUnit As SCAPI.PersistenceUnit
        If nIdx >= 0 Then
            Set oUnit = oApplication.PersistenceUnits(nIdx)
        Else
            Set oUnit = Nothing
        End If
        
        If Not oSession.Open(oUnit, eLevel) Then
            MsgBox "Failed to open a session An error is " + Err.Description
            oApplication.Sessions.Clear
            Exit Sub
        End If
        
        ' Have the open session checked
        mnModelsArray(Index).Checked = True
        
        ' Enable close open model item
        mnClose.Enabled = True
        
        ' Prepare a tree
        PrepareObjectTree
    
    End If
End Sub
' Close the open model
Private Sub mnClose_Click()

    ' Check if have a model to close
    Dim RootNode As Node
    
    If tvObjects.Nodes.Count > 0 Then
        Set RootNode = tvObjects.Nodes.Item(1)
        ' Release the session
        oSession.Close
        Set oSession = Nothing
        ' Remove the unit from available
        oApplication.PersistenceUnits.Remove KeyToObjId(RootNode.Key)
    End If

    PopulateModels
    
    ClearViews
End Sub

Private Sub ClearViews()
    ' Reset the properties listbox
    ClearPropertyView
    
    ' reset the model tree
    ClearObjectView
    
    ' Disable close open model item
    mnClose.Enabled = False

End Sub

Private Sub ClearObjectView()
    ' reset the model tree
    tvObjects.Visible = False
    With tvObjects.Nodes
        For i = 1 To tvObjects.Nodes.Count
            tvObjects.Nodes.Remove tvObjects.Nodes.Count
        Next i
    End With
    tvObjects.Visible = True
    
End Sub
Private Sub ClearPropertyView()
    ' Reset the properties listbox
    tvProperties.Visible = False
    With tvProperties.Nodes
        For i = 1 To tvProperties.Nodes.Count
            tvProperties.Nodes.Remove tvProperties.Nodes.Count
        Next i
    End With
    tvProperties.Visible = True
    
End Sub



' Forms a repository root object
' Assumes a session is open

Private Sub PrepareObjectTree()
On Error GoTo OnError

    ' Reset the control
    ClearObjectView
    
    ' Get the root object
    Dim oRoot As SCAPI.ModelObject
    
    Set oRoot = oSession.ModelObjects.Root
    If Not (oRoot Is Nothing) Then
        ' Form a root
        Dim ItemKey As String
        Dim strFlags As String
        
        ' Build a key. Prefix an object id with a number to make it unique
        ' in case if the view will have another instance of the same object
        ItemKey = "R0 " + oRoot.ObjectId
        strFlags = ObjectFlags(oRoot)
        
        tvObjects.Nodes.Add , , ItemKey, _
                    oRoot.Name + " (" + oRoot.ClassName + ")" + _
                    IIf(Len(strFlags) > 0, " { " + strFlags + " }", "")
                    
        
    End If
    Exit Sub
    
OnError:
    MsgBox "Failed to init the tree view due to " + Err.Description

End Sub

' Populate a tree view with children of the selected object
Private Sub tvObjects_DblClick()
    On Error GoTo OnErrors
    Dim bObjectFailed As Boolean
    
    ' Check if the selected has children
    If (tvObjects.SelectedItem.Children = 0) Then
        ' Try to expand
        Dim oSelectedCollection As SCAPI.ModelObjects
        Dim oLastNode As Node
        
        Me.MousePointer = vbHourglass
        
        Set oLastNode = Nothing
        
        ' Create a subcollection with the selected object as a root
        Set oSelectedCollection = oSession.ModelObjects.Collect(KeyToObjId(tvObjects.SelectedItem.Key), , 1)
        If (Not (oSelectedCollection Is Nothing)) Then
            ' Iterate through
            Dim oObject As SCAPI.ModelObject
            Dim ItemKey As String
            Dim strFlags As String
            
            For Each oObject In oSelectedCollection
                ' Test if an object is valid
                bObjectFailed = False
                If oObject.IsValid Then
                    If bObjectFailed Then GoTo next_object
                    ' Collect flags
                    strFlags = ObjectFlags(oObject)
                    
                    If (oLastNode Is Nothing) Then
                        ' This is the first child
                        
                        ' Build a key. Prefix an object id with a number to make it unique
                        ' in case if the view will have another instance of the same object
                        ItemKey = "C" + Str(tvObjects.SelectedItem.Index + 1) + " " + oObject.ObjectId
                        Set oLastNode = tvObjects.Nodes.Add(tvObjects.SelectedItem.Index, tvwChild, _
                                                                ItemKey, oObject.Name + " (" + oObject.ClassName + " )" + _
                                    IIf(Len(strFlags) > 0, " { " + strFlags + " }", ""))
                        oLastNode.EnsureVisible
                    Else
                        ' This is a next child
                        
                        ' Build a key. Prefix an object id with a number to make it unique
                        ' in case if the view will have another instance of the same object
                        ItemKey = "S" + Str(oLastNode.Index + 1) + " " + oObject.ObjectId
                        Set oLastNode = tvObjects.Nodes.Add(oLastNode.Index, tvwNext, _
                                                                  ItemKey, oObject.Name + " (" + oObject.ClassName + " )" + _
                                    IIf(Len(strFlags) > 0, " { " + strFlags + " }", ""))
                                                                  
                    End If
                Else
                    If mnExtraDebug.Checked Then
                        MsgBox "An object with id: " + oObject.ObjectId + " is not available'"
                    End If
                End If
                    
next_object:
            Next oObject
            
        End If
        
        If (oLastNode Is Nothing) Then Beep
    
        Me.MousePointer = vbDefault
        
    Else
        ' Inverse the status
        tvObjects.SelectedItem.Expanded = tvObjects.SelectedItem.Children And (Not tvObjects.SelectedItem.Child.Visible)
    
    End If
    
    
    Exit Sub

OnErrors:
    If Err.Number = SCAPI.SCAPI_ERWIN_NOOBJECT Then         ' Object was not found
        bObjectFailed = True
        If mnExtraDebug.Checked Then
            MsgBox Err.Description
        End If
        Err.Clear
        Resume Next
    End If
        
    Me.MousePointer = vbDefault
    MsgBox "Failed to retrieve an object with error " + Err.Description
    
End Sub
' Retrieves object flags. Aranges them as a string to display
Private Function ObjectFlags(oObject As SCAPI.ModelObject) As String
    On Error GoTo OnErrors
    
    Dim Flags As SCAPI.SC_ModelObjectFlags
    
    ' Retrieve flags
    Flags = oObject.Flags
    
    ' Parse the result
    If Flags = SCD_MOF_DONT_CARE Then
        ObjectFlags = ""
    Else
        
        ' 0 -  Object is a persistence unit if set
        If Flags And SCD_MOF_PERSISTENCE_UNIT Then ObjectFlags = ObjectFlags + "Persistence Unit;"
        ' 1 -  Object is user-defined if set
        If Flags And SCD_MOF_USER_DEFINED Then ObjectFlags = ObjectFlags + "User-Defined;"
        ' 2 -  Object is root if set
        If Flags And SCD_MOF_ROOT = 0 Then ObjectFlags = ObjectFlags + "Root;"
        ' 3 -  Object is maintained by the tool if set
        If Flags And SCD_MOF_TOOL Then ObjectFlags = ObjectFlags + "Tool;"
        ' 4 -  Object is the default if set
        If Flags And SCD_MOF_DEFAULT Then ObjectFlags = ObjectFlags + "Default;"
        ' 5 -  Object has been changed in the transaction and has not saved
        If Flags And SCD_MOF_TRANSACTION Then ObjectFlags = ObjectFlags + "Modified;"
        
    End If
    
    Exit Function
OnErrors:
    On Error Resume Next
    Dim strName As String
    strName = "<unknown>"
    strName = oObject.ClassName
    MsgBox "Failed to collect flags for an object of " + strName + _
        " class with error " + Err.Description
    ObjectFlags = "<Error>"
End Function

Private Sub tvObjects_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    
    ' Clear properties area
    ClearPropertyView
    
    ' Save state of the mouse buttons
    
    btMouseLeft = False
    If (Button And vbLeftButton) Then btMouseLeft = True
    
End Sub

Private Sub tvObjects_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    ' Locate the node
    Dim oNode As ComctlLib.Node
    Set oNode = tvObjects.HitTest(x, y)
    If Not oNode Is Nothing Then
        ' We have a node. Extract an id
        tvObjects.ToolTipText = KeyToObjId(oNode.Key)
    Else
        tvObjects.ToolTipText = "Double click to expand"
    End If
    
End Sub

Private Sub tvObjects_NodeClick(ByVal Node As ComctlLib.Node)

    ' Make properties available
    btProperties.Enabled = True
    
    ' Locate the help
    If Not Node Is Nothing Then
        On Error Resume Next
        
        Dim oObject As SCAPI.ModelObject
        
        Set oObject = oSession.ModelObjects.Item(KeyToObjId(Node.Key))
        
    End If
    
End Sub


Private Function KeyToObjId(Key As String) As String

' Key include prefix to make it unique in case if an object exists more then
' once in the object view

    Dim nIdx As Long
    nIdx = InStr(Key, "{")
    KeyToObjId = Mid(Key, nIdx)

End Function


Private Sub tvProperties_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    ' Locate the node
    Dim oNode As ComctlLib.Node
    Set oNode = tvProperties.HitTest(x, y)
    If Not oNode Is Nothing Then
        ' We have a node
        tvProperties.ToolTipText = oNode.Key
    Else
        tvProperties.ToolTipText = ""
    End If
    
End Sub

Private Sub btProperties_Click()
    On Error GoTo OnErrors
    
    ' Check if we have a selection
    If Not tvObjects.SelectedItem Is Nothing Then
        ' Clear the property view
        ClearPropertyView
        
        ' Create a root
        Dim oSelObject As Node
        Set oSelObject = tvObjects.SelectedItem
        
        ' Select an object
        Dim oObject As SCAPI.ModelObject
        
        Set oObject = oSession.ModelObjects.Item(KeyToObjId(oSelObject.Key))
        If Not oObject Is Nothing Then
            Dim oRootNode As Node
            Set oRootNode = tvProperties.Nodes.Add(, , KeyToObjId(oObject.ClassId), _
                        "Properties of " + oSelObject.Text)
        
            ' Look in the object
            Dim oProperty As SCAPI.ModelProperty
            Dim oLastNode As Node
            Dim strFlags As String
            
            Set oLastNode = Nothing
            
            For Each oProperty In oObject.Properties
                ' This is for debug, to check if we have an item with such key
                On Error GoTo KeyError
                strFlags = PropertyFlags(oProperty)
            
                If (oLastNode Is Nothing) Then
                    ' This is the first child
                    Set oLastNode = tvProperties.Nodes.Add(oRootNode.Index, tvwChild, _
                           oProperty.ClassId, oProperty.ClassName + _
                           IIf(Len(strFlags) > 0, " { " + strFlags + " }", ""))
                    oLastNode.EnsureVisible
                Else
                    ' This is a next child
                    Set oLastNode = tvProperties.Nodes.Add(oLastNode.Index, tvwNext, _
                           oProperty.ClassId, oProperty.ClassName + _
                           IIf(Len(strFlags) > 0, " { " + strFlags + " }", ""))
                End If
                
                ' Populate values
                PopulateValues oProperty, oLastNode
                
                GoTo NextProp
KeyError:
                ' For Debug purposes, check if we have doubled key. Then ignore it
                If Err.Number <> 35602 Then GoTo OnErrors
                If mnExtraDebug.Checked Then
                    MsgBox "Object has more the one instance of property with name " + oProperty.ClassName
                End If
                Err.Clear
                Resume Next
NextProp:
            Next oProperty
        End If
    
    Else
        ClearPropertyView
        btProperties.Enabled = False
    End If
    Exit Sub
    
OnErrors:
    Me.MousePointer = vbDefault
    MsgBox "Failed to retrieve an object properties with error " + Err.Description
    ClearPropertyView
    

End Sub
' Retrieves property flags and value type. Aranges them as a string to display
Private Function PropertyFlags(oProperty As SCAPI.ModelProperty) As String
    On Error GoTo OnErrors
    
    Dim Flags As SCAPI.SC_ModelPropertyFlags
    
    Dim strDatatype(23) As String
    ' Populate it
    strDatatype(0) = "SCVT_NULL;": strDatatype(1) = "SCVT_I2;": strDatatype(2) = "SCVT_I4;"
    strDatatype(3) = "SCVT_UI1;": strDatatype(4) = "SCVT_R4;": strDatatype(5) = "SCVT_R8;"
    strDatatype(6) = "SCVT_BOOLEAN;": strDatatype(7) = "SCVT_CURRENCY;": strDatatype(8) = "SCVT_IUNKNOWN;"
    strDatatype(9) = "SCVT_IDISPATCH;": strDatatype(10) = "SCVT_DATE;": strDatatype(11) = "SCVT_BSTR;"
    strDatatype(12) = "SCVT_UI2;": strDatatype(13) = "SCVT_UI4;": strDatatype(14) = "SCVT_GUID;"
    strDatatype(15) = "SCVT_OBJID;": strDatatype(16) = "SCVT_BLOB;": strDatatype(17) = "SCVT_DEFAULT;"
    strDatatype(18) = "SCVT_I1;": strDatatype(19) = "SCVT_INT;": strDatatype(20) = "SCVT_UINT;"
    strDatatype(21) = "SCVT_RECT;": strDatatype(22) = "SCVT_POINT;"
    
    ' Retrieve flags
    Flags = oProperty.Flags
    
    ' Get the value type
    Dim eType As SCAPI.SC_ValueTypes
    
    eType = oProperty.DataType(0)
    
    PropertyFlags = strDatatype(eType)
    
    ' Parse the result
    
    ' 0 -  Property has a NULL value if set
    If Flags And SCD_MPF_NULL Then PropertyFlags = PropertyFlags + "Null;"
    ' 1 -  Property is user-defined if set
    If Flags And SCD_MPF_USER_DEFINED Then PropertyFlags = PropertyFlags + "User-Defined;"
    ' 2 -  Property is scalar if set
    If (Flags And SCD_MPF_SCALAR) = 0 Then PropertyFlags = PropertyFlags + "Vector;"
    ' 3 -  Property is maintained by the tool, if set
    If Flags And SCD_MPF_TOOL Then PropertyFlags = PropertyFlags + "Tool;"
    ' 4 -  Property is read-only if set
    If Flags And SCD_MPF_READ_ONLY Then PropertyFlags = PropertyFlags + "ReadOnly;"
    ' 5 -  Property has inherited/calculated/derived value if set
    If Flags And SCD_MPF_DERIVED Then PropertyFlags = PropertyFlags + "Derived;"
    ' 6 -  Property is optional and could be removed
    If Flags And SCD_MPF_OPTIONAL Then PropertyFlags = PropertyFlags + "Optional;"
    
    Exit Function
OnErrors:
    On Error Resume Next
    Dim strName As String
    strName = "<unknown>"
    strName = oProperty.ClassName
    MsgBox "Failed to collect flags for a property of " + strName + _
        " class with error " + Err.Description
    PropertyFlags = "<Error>"
End Function

' Populate a sub-tree for a specific property in Properties ListView
Private Sub PopulateValues(oProperty As SCAPI.ModelProperty, oNode As Node)

    On Error GoTo OnErrors
    ' WHat type of a property we have
    If oProperty.Flags And SCD_MPF_SCALAR Then
        ' SCalar value
        tvProperties.Nodes.Add oNode.Index, tvwChild, , RetrieveValue(oProperty, 0)
    Else
        ' Vector value
        Dim nCount As Long
        nCount = oProperty.Count
        
        Dim nIdx As Long
        Dim oLastNode As Node
        Set oLastNode = Nothing
        If nCount > 0 Then
            For nIdx = 0 To nCount - 1
                If oLastNode Is Nothing Then
                    Set oLastNode = tvProperties.Nodes.Add(oNode.Index, tvwChild, , _
                             RetrieveValue(oProperty, nIdx))
                Else
                    Set oLastNode = tvProperties.Nodes.Add(oLastNode.Index, tvwNext, , _
                             RetrieveValue(oProperty, nIdx))
                End If
            Next nIdx
        End If
    End If
        
    oNode.Expanded = False
        
    Exit Sub
OnErrors:
    On Error Resume Next
    Dim strName As String
    strName = "<unknown>"
    strName = oProperty.ClassName
    MsgBox "Failed to populate property " + strName + _
        " with error " + Err.Description
    If Not oNode Is Nothing Then
        tvProperties.Nodes.Add oNode.Index, tvwChild, , "<Error>"
    End If
    
End Sub

' Retrieve a property or a property element value
Private Function RetrieveValue(oProperty As SCAPI.ModelProperty, nIndex As Long) As String

    On Error GoTo OnErrors
    ' WHat type of a property we have
    Dim bScalar As Boolean
    bScalar = (oProperty.Flags And SCD_MPF_SCALAR)
        
   ' Retrieve value in native format
   
   ' We use SCAPI value types since they provide more precise info
   Dim eType As SCAPI.SC_ValueTypes
   Dim ArrayLong() As Long
   
   If bScalar Then
        ' SCalar value
        eType = oProperty.DataType
   Else
        ' Vector value
        eType = oProperty.DataType(nIndex)
   End If
   
   Dim strNative As String
   
   ' Parse the value.
   Select Case eType
   
    Case SCVT_I2, SCVT_I4, SCVT_UI1, SCVT_UI2, SCVT_UI4, SCVT_I1, SCVT_INT, SCVT_UINT
        ' This is all numeric
        If bScalar Then
            strNative = CStr(oProperty.Value)
        Else
            strNative = CStr(oProperty.Value(nIndex))
        End If
    Case SCVT_R4, SCVT_R8
        ' This is all float
        If bScalar Then
            strNative = CStr(oProperty.Value)
        Else
            strNative = CStr(oProperty.Value(nIndex))
        End If
    
    Case SCVT_BOOLEAN
        ' This is boolean
        If bScalar Then
            strNative = CStr(oProperty.Value)
        Else
            strNative = CStr(oProperty.Value(nIndex))
        End If
        
    Case SCVT_CURRENCY
        ' This is currency
        If bScalar Then
            strNative = CStr(oProperty.Value)
        Else
            strNative = CStr(oProperty.Value(nIndex))
        End If
        
    Case SCVT_DATE
        ' This is date
        If bScalar Then
            strNative = Format(oProperty.Value, "General Date")
        Else
            strNative = Format(oProperty.Value(nIndex), "General Date")
        End If
        
    Case SCVT_BSTR
        ' This is string
        If bScalar Then
            strNative = oProperty.Value
        Else
            strNative = oProperty.Value(nIndex)
        End If
        
    Case SCVT_GUID, SCVT_OBJID
        ' This is guid, objectid, class id
        If bScalar Then
            strNative = oProperty.Value
        Else
            strNative = oProperty.Value(nIndex)
        End If
        
    Case SCVT_BLOB
        ' This is unformated data
        strNative = "<blob>"
    
    Case SCVT_RECT
        ' This is a rectange
        If bScalar Then
            ArrayLong = oProperty.Value
        Else
            ArrayLong = oProperty.Value(nIndex)
        End If
        
        strNative = "(" + CStr(ArrayLong(0)) + "," + _
                        CStr(ArrayLong(1)) + "," + _
                        CStr(ArrayLong(2)) + "," + _
                        CStr(ArrayLong(3)) + ")"
    Case SCVT_POINT
        ' This is a rectange
        If bScalar Then
            ArrayLong = oProperty.Value
        Else
            ArrayLong = oProperty.Value(nIndex)
        End If
        
        strNative = "(" + CStr(ArrayLong(0)) + "," + _
                        CStr(ArrayLong(1)) + ")"
    Case Else
        ' error, format is not supported
        strNative = "<error: variant type - " + TypeName(Value) + " SCAPI type - " + Str(eType)
        
   End Select

    ' Retrieve value as a string
   Dim strValue As String
   If bScalar Then
        ' SCalar value
        strValue = oProperty.FormatAsString
   Else
        ' Vector value
        strValue = oProperty.Value(nIndex, SCVT_BSTR)
   End If

   RetrieveValue = strNative + " ( s= " + strValue + " )"
   
   Exit Function
OnErrors:
    On Error Resume Next
    Dim strName As String
    strName = "<unknown>"
    strName = oProperty.ClassName
    RetrieveValue = "Failed to populate property " + strName + _
        " with error " + Err.Description

End Function


